home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1995 November / EnigmA AMIGA RUN 02 (1995)(G.R. Edizioni)(IT)[!][issue 1995-11][Skylink CD].iso / earcd / program / misc / m2pica.lha / M2Pica / Txt / DBuf.mod next >
Text File  |  1995-08-21  |  3KB  |  131 lines
  1. (*******************************************************************************
  2.  : Program.         DBuf.MOD
  3.  : Author.          Carsten Wartmann (Crazy Video)
  4.  : Address.         Wutzkyallee 83, 12353 Berlin
  5.  : Phone.           030/6614776
  6.  : Version.         0.99
  7.  : Date.            22.Feb.1994
  8.  : Copyright.       PD
  9.  : Language.        Modula-2
  10.  : Compiler.        M2Amiga V4.096d
  11.  : Contents.        Demo des Double Buffering der Picasso.
  12. *******************************************************************************)
  13.  
  14. MODULE DBuf ;
  15.  
  16.  
  17. FROM SYSTEM   IMPORT ADR,ADDRESS,TAG,BYTE,BITSET ;
  18.  
  19. FROM UtilityD IMPORT tagEnd,tagDone ;
  20.  
  21. FROM Arts     IMPORT Assert ;
  22.  
  23. FROM ExecL    IMPORT Forbid,Permit ;
  24.  
  25. FROM DosL     IMPORT Delay ;
  26.  
  27. FROM GraphicsL  IMPORT SetRGB4 ;
  28.  
  29. FROM IntuitionD IMPORT ScreenPtr ;
  30. FROM IntuitionL IMPORT ScreenToFront ;
  31.  
  32. FROM RandomNumber IMPORT RND ;
  33.  
  34. FROM VilIntuiSupL IMPORT OpenVillageScreenTagList,CloseVillageScreen,GetMemSize,
  35.                          LockVillageScreen,UnLockVillageScreen,VillageRectFill,
  36.                          WaitVillageBlit,OpenVillageScreen,VillageModeRequest,
  37.                          VillageSetDisplayBuf,VillageGetBufAddr ;
  38. FROM VilIntuiSupD IMPORT SetPackedPixel,SetTrueColorPixel,SetPPM,LinePacked,
  39.                          VilFillRecord,TavisTags,InvalidID ;
  40.  
  41.  
  42.  
  43.  
  44. VAR scr    : ScreenPtr ;
  45.     start,
  46.     oldadr : ADDRESS ;
  47.     col    : LONGINT ;
  48.     ok,buf : LONGCARD ;
  49.     bufadr : ARRAY [0..1] OF ADDRESS ;
  50.     xa,ya  : ARRAY [0..1] OF LONGINT ;
  51.     x,y,
  52.     xs,ys,
  53.     i      : LONGINT ;
  54.     fill   : VilFillRecord ;
  55.     tags   : ARRAY [0..40] OF LONGCARD ;
  56.  
  57.     cia[0BFE000H]  : BITSET ;
  58.  
  59.  
  60.  
  61. BEGIN
  62.   scr := OpenVillageScreenTagList(TAG(tags,tavisScreenWidth  , 640,
  63.                                            tavisScreenHeight , 480,
  64.                                            tavisScreenDepth  ,   8,
  65.                                            tavisDoubleBuffer,    2,
  66.                                            tagDone)) ;
  67.  
  68.   Assert(scr#NIL,ADR("Kann PICASSO Screen nicht öffnen !")) ;
  69.  
  70.   FOR col:=1 TO 255 DO
  71.     SetRGB4(ADR(scr^.viewPort),col,col,255-col,0) ;
  72.   END ;
  73.  
  74.   start := LockVillageScreen(scr) ;
  75.   UnLockVillageScreen(scr) ;
  76.  
  77.   FOR buf:=0 TO 1 DO
  78.     bufadr[buf] := VillageGetBufAddr(scr,buf) ;
  79.   END ;
  80.  
  81.   xs := 4 ;
  82.   ys := 5 ;
  83.  
  84.   buf := 1 ;
  85.   VillageSetDisplayBuf(scr,0) ;
  86.  
  87.   WHILE (6 IN cia) DO
  88.     INC(x,xs) ;
  89.     INC(y,ys) ;
  90.  
  91.     IF (x>=540) OR (x<=0) THEN
  92.       xs:=xs*(-1) ;
  93.       INC(x,xs) ;
  94.     END ;
  95.  
  96.     IF (y>=380) OR (y<=0) THEN
  97.       ys:=ys*(-1) ;
  98.       INC(y,ys) ;
  99.     END ;
  100.  
  101.     fill.dstAdr   := ADDRESS(LONGINT(bufadr[buf]) + LONGINT(scr^.width) * ya[buf] + xa[buf]) ;
  102.     fill.color    := 0 ;
  103.     fill.width    := 100 ;
  104.     fill.height   := 100 ;
  105.     ok := VillageRectFill(scr,ADR(fill)) ;
  106.     WaitVillageBlit ;
  107.  
  108.     fill.dstAdr   := ADDRESS(LONGINT(bufadr[buf]) + LONGINT(scr^.width) * y + x) ;
  109.     fill.dstPitch := scr^.width ;
  110.     fill.width    := 100 ;
  111.     fill.height   := 100 ;
  112.     fill.color    := x MOD 255 + 1 ;
  113.     xa[buf] := x ;
  114.     ya[buf] := y ;
  115.  
  116.     ok := VillageRectFill(scr,ADR(fill)) ;
  117.     WaitVillageBlit ;
  118.  
  119.     VillageSetDisplayBuf(scr,buf) ;
  120.     buf := (buf + 1) MOD 2 ;
  121.  
  122.   END ;
  123.  
  124. CLOSE
  125.   IF scr#NIL THEN
  126.     UnLockVillageScreen(scr) ;
  127.     CloseVillageScreen(scr) ;
  128.   END ;
  129.  
  130. END DBuf .
  131.